REM  ScreenPrint
REM  Carolyn Scheppner   CBM  04/86
REM
REM  Graphic screen dump to the printer
REM   using exec library calls
REM  Requires exec.bmap
REM  Use Preferences to select options
REM   such as GrayScale and Negative

REM  ***  Calling Program  ***

REM  Custom Screen, some graphics
w = 320: h = 200: d = 5
SCREEN 2,w,h,d,1
t$=" D = Draw   P = Print   Q = Quit "
WINDOW 2,t$,,15,2
PALETTE 0,1,1,1
PALETTE 1,0.2,0.4,0.8

GOSUB DrawLines:

MainLoop:
k$ = INKEY$
IF k$ = "d" THEN 
   GOSUB DrawLines:
ELSEIF k$ = "p" THEN
   BorderFlag% = 0  'No borders printed
   GOSUB ScreenDump
   REM  Time to read any error msgs
   FOR de = 1 TO 5000: NEXT
ELSEIF k$ = "q" THEN 
   GOTO Quit:
END IF
GOTO MainLoop:

Quit:
WINDOW CLOSE 2
SCREEN CLOSE 2
END


DrawLines:
CLS               
RANDOMIZE  TIMER
FOR k = 1 TO 12
   x1 = 80 + INT(RND(1) * (w - 160)) 
   x2 = 80 + INT(RND(1) * (w - 160))
   y1 = 40 + INT(RND(1) * (h - 100))
   y2 = 40 + INT(RND(1) * (h - 100))
   dx = 2 + INT(RND(1) * 3)
   IF RND(1) < 0.5 THEN dx = -dx
   dy = 2 + INT(RND(1) * 2)
   IF RND(1) < 0.5 THEN dy = -dy
   co = 1 + INT(RND(1) * 16)
   nl = 12 + INT(RND(1) * 10) 
   FOR j = 1 TO nl
      LINE (x1,y1)-(x2,y2),co
      x1 = x1 + dx
      x2 = x2 + dx
      y1 = y1 + dy
      y2 = y2 - dy
   NEXT
NEXT
RETURN


END


ScreenDump:

REM  If first call of this routine 
REM   declare the exec library functions
REM    which return values

IF AlreadyDeclared = 0 THEN
 DECLARE FUNCTION AllocSignal%() LIBRARY
 DECLARE FUNCTION AllocMem&()    LIBRARY
 DECLARE FUNCTION FindTask&()    LIBRARY
 DECLARE FUNCTION DoIO&()        LIBRARY
 DECLARE FUNCTION OpenDevice&    LIBRARY
 AlreadyDeclared = 1
END IF

REM  Get addresses of the structures

sWindow&   = WINDOW(7)
sScreen&   = PEEKL(sWindow& + 46)
sViewPort& = sScreen& + 44
sRastPort& = sScreen& + 84
sColorMap& = PEEKL(sViewPort& + 4)

REM  Get Screen width, height, modes 

maxWidth%  = PEEKW(sScreen& + 12)
maxHeight% = PEEKW(sScreen& + 14)
viewModes% = PEEKW(sViewPort& + 32)

REM Set up parameters for dump command

command%  = 11   'Printer command number
srcX% = 0        'Send whole screen
srcY% = 0 
srcWidth%  = maxWidth%
srcHeight% = maxHeight%
destRows& = 0    'Dump will compute
destCols& = 0
special% = &H84  'FullCol | Aspect

IF BorderFlag% = 0 THEN  'No Borders
   srcX% = srcX% + 3
   srcY% = srcY% + 11
   srcWidth%  = srcWidth% - 3 - 11
   srcHeight% = srcHeight% - 11 - 3
END IF   

LIBRARY "exec.library"


REM *** CreatePort ***

sigBit% =  AllocSignal%(-1)
ClearPublic& = 65537
msgPort& = AllocMem&(40,ClearPublic&)
IF msgPort& = 0 THEN
   PRINT "Can't allocate msgPort"
   GOTO cleanup4
END IF


POKE(msgPort& + 8), 4 'Type=NT_MSGPORT
POKE(msgPort& + 9), 0 'Priority 0 
portName$ = "MyPrtPort"+CHR$(0)
POKEL(msgPort& + 10), SADD(portName$)
POKE(msgPort& + 14), 0 'Flags
POKE(msgPort& + 15), sigBit%
sigTask& = FindTask&(0)
POKEL(msgPort& + 16), sigTask&

CALL AddPort(msgPort&)  'Add the port 


REM  *** CreatExtIO ***

ioRequest& = AllocMem&(64,ClearPublic&)
IF ioRequest& = 0  THEN
   PRINT "Can't allocate ioRequest"
   GOTO cleanup3
END IF

POKE(ioRequest& + 8),5 'Type=NT_MESSAGE
POKE(ioRequest& + 9),0 'Priority 0
POKEL(ioRequest& + 14), msgPort&


REM  *** Open the Printer Device ***

devName$ = "printer.device"+CHR$(0)
pError& = OpenDevice&(SADD(devName$),0,ioRequest&,0)
IF pError& <> 0  THEN
   PRINT "Can't open printer"
   GOTO cleanup2
END IF


REM  *** Dump the RastPort ***

POKEW(ioRequest& + 28), command%
POKEL(ioRequest& + 32), sRastPort&
POKEL(ioRequest& + 36), sColorMap&
POKEL(ioRequest& + 40), viewModes%
POKEW(ioRequest& + 44), srcX%
POKEW(ioRequest& + 46), srcY%
POKEW(ioRequest& + 48), srcWidth%
POKEW(ioRequest& + 50), srcHeight%
POKEL(ioRequest& + 52), destCols&
POKEL(ioRequest& + 56), destRows&
POKEW(ioRequest& + 60), special%

ioError& = DoIO&(ioRequest&)
IF ioError& <> 0 THEN
   PRINT "DumpRPort error =" ioError&
   GOTO cleanup1
END IF


cleanup1:
   REM  *** Close Printer Device ***
   CALL CloseDevice(ioRequest&)

cleanup2:
   REM  *** DeleteExtIO ***
   POKE(ioRequest& + 8), &Hff
   POKEL(ioRequest& + 20), &Hffff
   POKEL(ioRequest& + 24), &Hffff
   CALL FreeMem(ioRequest&,64)

cleanup3:
   REM  *** DeletePort ***
   CALL RemPort(msgPort&)
   POKE(msgPort& + 8), &Hff  
   POKEL(msgPort& + 20), &Hffff
   CALL FreeSignal(sigBit%)
   CALL FreeMem(msgPort&,40)
   
cleanup4:   
   LIBRARY CLOSE

RETURN